home *** CD-ROM | disk | FTP | other *** search
- (*************************************************************************
-
- $RCSfile: OberonClock.mod $
- Description: Implementation of the Oberon System date/time routines.
-
- Created by: fjc (Frank Copeland)
- $Revision: 1.2 $
- $Author: fjc $
- $Date: 1995/06/04 23:24:07 $
-
- Copyright © 1995, Frank Copeland.
- This file is part of the Oberon-A Library.
- See Oberon-A.doc for conditions of use and distribution.
-
- *************************************************************************)
-
- <*STANDARD-*>
-
- MODULE OberonClock;
-
- IMPORT SYS := SYSTEM, d := Dos;
-
- (*------------------------------------*)
- PROCEDURE ADOS2OberonTime * (VAR ds : d.Date; VAR time, date : LONGINT);
- (*
- Adapted from ParseDate() in module Dates, Copyright 1987 by:
- Dale W. Thompson, 14500 Dallas Pkwy. #2091, Dallas, TX 75240
- *)
-
- VAR year, month, day, hour, min, sec : LONGINT;
- Days : ARRAY 12 OF INTEGER;
- LeapDays : ARRAY 12 OF INTEGER;
-
- PROCEDURE Leap ( year : LONGINT ) : BOOLEAN;
- BEGIN
- RETURN ((year-1976) MOD 4) = 0
- END Leap;
-
- BEGIN (* ADOS2OberonTime *)
- hour := ds.minute DIV 60;
- min := ds.minute MOD 60;
- sec := ds.tick DIV d.ticksPerSecond;
-
- Days[0] := 31; LeapDays[0] := 31;
- Days[1] := 28; LeapDays[1] := 29;
- Days[2] := 31; LeapDays[2] := 31;
- Days[3] := 30; LeapDays[3] := 30;
- Days[4] := 31; LeapDays[4] := 31;
- Days[5] := 30; LeapDays[5] := 30;
- Days[6] := 31; LeapDays[6] := 31;
- Days[7] := 31; LeapDays[7] := 31;
- Days[8] := 30; LeapDays[8] := 30;
- Days[9] := 31; LeapDays[9] := 31;
- Days[10] := 30; LeapDays[10] := 30;
- Days[11] := 31; LeapDays[11] := 31;
-
- day := ds.days;
- year := 1978;
- LOOP
- IF Leap (year) THEN
- IF day < 366 THEN
- EXIT;
- ELSE
- DEC( day,366 );
- END;
- ELSE
- IF day < 365 THEN
- EXIT;
- ELSE
- DEC( day,365 );
- END;
- END;
- INC (year);
- END; (* LOOP *)
- INC (day);
-
- month := 0;
- IF Leap (year) THEN
- WHILE day > LeapDays [month] DO
- DEC (day, LeapDays [month]);
- INC (month);
- END;
- ELSE
- WHILE day > Days [month] DO
- DEC (day, Days [month]);
- INC (month);
- END;
- END;
- INC (month);
-
- time := (hour * 64 + min) * 64 + sec;
- date := (year * 16 + month) * 32 + day;
- END ADOS2OberonTime;
-
- (*------------------------------------*)
- PROCEDURE GetClock * (VAR time, date : LONGINT);
-
- VAR ds : d.Date;
-
- BEGIN (* GetClock *)
- d.DateStamp (ds);
- ADOS2OberonTime (ds, time, date);
- END GetClock;
-
- END OberonClock.
-